home *** CD-ROM | disk | FTP | other *** search
- #! /usr/bin/perl
-
- require "getopts.pl";
- require "msg.pl";
- require "imap.pl";
-
- &Getopts('bde:h:il:np:qrt:u:x');
-
- $body = $opt_b; # retrieve BODY[1] instead of RFC822.TEXT
- $debug = $opt_d; # debug mode
- $efficiency = $opt_e; # efficiency
- $host = $opt_h; # specify IMAP host (localhost)
- $important = $opt_i; # flag retrieved messages as important
- $limit = $opt_l; # only retrieve messages smaller than specified value
- $new = $opt_n; # flag retrieved messages as new
- $port = $opt_p; # specify IMAP port (143)
- $quiet = $opt_q; # quiet mode
- $remove = $opt_r; # delete retrieved messages
- $timeout = $opt_t; # place timeout on reading lines
- $user = $opt_u; # use another name to login
- $expunge = $opt_x; # expunge regularly
-
- $host = 'localhost' unless $host;
- $port = 143 unless $port;
- $user = getpwuid($>) unless $user;
- $timeout = 0 unless $timeout;
-
- $important = 1 if $new; # flag as new implies flag as important
-
- $efficiency = 10 unless $efficiency > 0;
-
- $pid = 0;
-
- &msg'level(2) if $debug;
- &msg'level(0) if $quiet;
-
- if (! defined($ENV{"HOME"}))
- {
- &msg'error("HOME not set");
- exit 1;
- }
- $home = $ENV{"HOME"};
-
- if (! open(RC, "$home/.imapsyncrc"))
- {
- &msg'error("can not open ~/.imapsyncrc");
- exit 1;
- }
-
- $numboxes = 0;
- while (chop($mbox = <RC>))
- {
- if (! $mbox =~ /^\s*$/)
- {
- push(@mailboxes, $mbox);
- $numboxes++;
- }
- }
-
- close(RC);
-
- &msg'msg("$numboxes mailbox: @mailboxes") if ($numboxes == 1);
- &msg'msg("$numboxes mailboxes: @mailboxes") if ($numboxes != 1);
-
- $totalmsgs = 0;
- $totalmsgskips = 0;
- $totalmsgerrors = 0;
-
- if (! &imap'init(\&message, \&mailbox, \&exists, \&recent, \&expunge, \&flags,
- \&search, \&fetch))
- {
- &msg'error("can not initialize");
- exit 1;
- }
-
- if (! &imap'open($host, $port))
- {
- &msg'error("can not make connection");
- exit 1;
- }
-
- $tag = &imap'login($user);
- ($match, $result, $message) = &imap'loop($tag,$timeout);
- if ($result ne "OK")
- {
- &msg'error("$message");
- &imap'close();
- exit 1;
- }
-
- MAILBOX:
- foreach $mbox (@mailboxes)
- {
- &msg'msg("scanning mailbox $mbox");
-
- $tag = &imap'select($mbox);
- ($match, $result, $message) = &imap'loop($tag,$timeout);
- if ($result ne "OK")
- {
- &msg'error("$message");
- next MAILBOX;
- }
- &msg'msg("$mailbox{$mbox}->{'exists'} messages, $mailbox{$mbox}->{'recent'} recent");
-
- # if ($mailbox{$mbox}->{'recent'} == 0)
- # {
- # &msg'msg("skipping mailbox");
- # next MAILBOX;
- # }
-
- $tag = &imap'search("UNSEEN");
-
- # reset some variables in the meantime
- $msgs = 0;
- $msgskips = 0;
- $msgerrors = 0;
-
- ($match, $result, $message) = &imap'loop($tag,$timeout);
- if ($result ne "OK")
- {
- &msg'error("$message");
- &imap'close();
- exit 1;
- }
-
- @seqlist = split(' ', $mailbox{$mbox}->{'search'});
- $seqcount = $#seqlist + 1;
- $seqoffset = 0;
-
- FETCH:
- while ($seqcount - $seqoffset > 0)
- {
- if ($seqcount - $seqoffset < $efficiency)
- {
- $seqrange = $seqcount - $seqoffset;
- }
- else
- {
- $seqrange = $efficiency;
- }
-
- @sequence = @seqlist[$seqoffset..($seqoffset+$seqrange-1)];
- $sequence = join(',', @sequence);
-
- $seqoffset = $seqoffset+$seqrange;
-
- $tag = &imap'fetch("$sequence", "ALL");
- ($match, $result, $message) = &imap'loop($tag,$timeout);
- if ($result ne "OK")
- {
- &msg'error("$message");
- &imap'close();
- exit 1;
- }
- foreach $i (0..$#sequence)
- {
- $size = $message{@sequence[$i]}->{'size'};
- if ($size && $limit > 0 && $size > $limit)
- {
- &msg'warn("skipping message @sequence[$i], $size bytes long");
- @sequence[$i] = '';
- $msgskips++;
- }
- else
- {
- &msg'msg("retrieving message @sequence[$i], $size bytes long");
- $msgs++;
- }
- }
- $sequence = join(' ', @sequence);
- $sequence =~ s/^\s*(.*)\s*$/$1/;
- @sequence = split(/\s+/, $sequence);
- $sequence = join(',', @sequence);
-
- if (length($sequence) > 0)
- {
- if ($body)
- {
- $fetch = "(RFC822.HEADER BODY[1])";
- }
- else
- {
- $fetch = "(RFC822.HEADER RFC822.TEXT)";
- }
- $tag = &imap'fetch("$sequence", "$fetch");
- ($match, $result, $message) = &imap'loop($tag,$timeout);
- if ($result ne "OK")
- {
- &msg'error("$message");
- &imap'close();
- exit 1;
- }
-
- # wait for child process if it is still running
- if ($pid)
- {
- waitpid($pid, 0);
- }
-
- unless($pid = fork())
- {
- foreach $i (0..$#sequence)
- {
- # Linux: change this to: open(FORMAIL, "| deliver -A <username>")
- if (! open(FORMAIL, "| formail -Ys procmail"))
- {
- &msg'error("can not pipe to formail");
- &imap'close();
- exit 1;
- }
- print FORMAIL $message{@sequence[$i]}->{'header'};
- if ($body)
- {
- print FORMAIL $message{@sequence[$i]}->{'body'};
- }
- else
- {
- print FORMAIL $message{@sequence[$i]}->{'text'};
- }
- if (! close(FORMAIL) || $?)
- {
- &msg'error("formail failed");
- &imap'close();
- exit 1;
- }
- }
- exit 0;
- }
-
- if ($remove || $important)
- {
- $flags = "\\DELETED" if ($remove);
- $flags = "\\FLAGGED" if ($important);
- $tag = &imap'store("$sequence", "+FLAGS", "($flags)");
- ($match, $result, $message) = &imap'loop($tag,$timeout);
- if ($result ne "OK")
- {
- &msg'error("$message");
- &imap'close();
- exit 1;
- }
- if ($new)
- {
- $tag = &imap'store("$sequence", "-FLAGS", "(\\SEEN)");
- ($match, $result, $message) = &imap'loop($tag,$timeout);
- if ($result ne "OK")
- {
- &msg'error("$message");
- &imap'close();
- exit 1;
- }
- }
- }
-
- # expunge messages
- if ($remove && $expunge)
- {
- $tag = &imap'expunge();
- ($match, $result, $message) = &imap'loop($tag,$timeout);
- if ($result ne "OK")
- {
- &msg'error("$message");
- &imap'close();
- exit 1;
- }
-
- # determine message sequence again that is still UNSEEN
- # it was changed c.q. shifted by the expunge
- $tag = &imap'search("UNSEEN");
- ($match, $result, $message) = &imap'loop($tag,$timeout);
- if ($result ne "OK")
- {
- &msg'error("$message");
- &imap'close();
- exit 1;
- }
-
- @seqlist = split(' ', $mailbox{$mbox}->{'search'});
- $seqcount = $#seqlist + 1;
- $seqoffset = $msgskips;
- }
- }
-
- undef %message;
- }
-
- # expunge messages if not already done earlier by regular expunge mode
- if ($remove && $expunge != 1)
- {
- $tag = &imap'expunge();
- ($match, $result, $message) = &imap'loop($tag,$timeout);
- if ($result ne "OK")
- {
- &msg'error("$message");
- &imap'close();
- exit 1;
- }
- }
-
- if ($msgs + $msgskips + $msgerrors > 0)
- {
- &msg'msg("$msgs retrieved, $msgskips skipped, $msgerrors errors");
- $totalmsgs += $msgs;
- $totalmsgskips += $msgskips;
- $totalmsgerrors += $msgerrors;
- }
- }
-
- $tag = &imap'logout();
- ($match, $result, $message) = &imap'loop($tag,$timeout);
- if ($result ne "OK")
- {
- &msg'error("$message");
- &imap'close();
- exit 1;
- }
-
- &imap'close();
-
- &msg'msg("total: $totalmsgs retrieved, $totalmsgskips skipped, $totalmsgerrors errors");
-
- # wait for child process if it is still running
- if ($pid)
- {
- waitpid($pid, 0);
- }
-
- exit 0;
-
-
-
- sub message
- {
- local($tag, $result, $message) = @_;
-
- &msg'debug("message $tag $result $message");
-
- if ($tag eq "*")
- {
- MESSAGE:
- {
- $result =~ /OK/i && do
- {
- &msg'msg("$message");
- last MESSAGE;
- };
- $result =~ /NO/i && do
- {
- &msg'warn("$message");
- last MESSAGE;
- };
- $result =~ /BAD/i && do
- {
- &msg'error("$message");
- last MESSAGE;
- };
- }
- }
- }
-
- sub mailbox
- {
- local($tag, $data) = @_;
-
- &msg'debug("mailbox $tag $data");
- }
-
- sub exists
- {
- local($tag, $result) = @_;
-
- &msg'debug("exists $tag $result");
-
- $mailbox{$mbox}->{'exists'} = $result;
- }
-
- sub recent
- {
- local($tag, $result) = @_;
-
- &msg'debug("recent $tag $result");
-
- $mailbox{$mbox}->{'recent'} = $result;
- }
-
- sub expunge
- {
- local($tag, $result) = @_;
-
- &msg'debug("expunge $tag $result");
-
- $mailbox{$mbox}->{'expunge'} = $result;
- }
-
- sub fetch
- {
- local($tag, $result, $data) = @_;
-
- &msg'debug("fetch $tag $result");
-
- if ($data =~ /RFC822\.SIZE\s+([0-9]+)/im)
- {
- $message{$result}->{'size'} = $1;
- }
- if ($data =~ /RFC822\.HEADER\s+\{([0-9]+)\}\015\012/im)
- {
- $message{$result}->{'header'} = substr($', 0, $1);
- }
- if ($data =~ /RFC822\.TEXT\s+\{([0-9]+)\}\015\012/im)
- {
- $message{$result}->{'text'} = substr($', 0, $1);
- }
- if ($data =~ /BODY\[1\]\s+\{([0-9]+)\}\015\012/im)
- {
- $message{$result}->{'body'} = substr($', 0, $1);
- }
- }
-
- sub flags
- {
- local($tag, $data) = @_;
-
- &msg'debug("flags $tag $data");
-
- $mailbox{$mbox}->{'flags'} = $data;
- }
-
- sub search
- {
- local($tag, $data) = @_;
-
- &msg'debug("search $tag $data");
-
- $mailbox{$mbox}->{'search'} = $data;
- }
-